Shareware Grab Bag

home *** CD-ROM | disk | FTP | other *** search

/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / designer.arc / DESIGNER.BAS < prev next >

Wrap

BASIC Source File | 1986-04-27 | 23.9 KB | 599 lines

10000 REM ************************************************************** 10010 REM ** THE DESIGNER V1.0 ** 10020 REM ** Copyright 1983, by Jan B. Young ** 10030 REM ************************************************************** 10040 KEY OFF:ON ERROR GOTO 14930:CAPS=1:PURGE=0 10050 OPEN "A:DESIGNER.DRV" FOR INPUT AS #1 10060 INPUT #1,DRIVE$ 10070 CLOSE #1 10080 KEY(1) ON:ON KEY(1) GOSUB 10440 10090 KEY(2) ON:ON KEY(2) GOSUB 10450 10100 KEY(3) ON:ON KEY(3) GOSUB 10460 10110 KEY(4) ON:ON KEY(4) GOSUB 10470 10120 KEY(5) ON:ON KEY(5) GOSUB 10480 10130 KEY(6) ON:ON KEY(6) GOSUB 10490 10140 KEY(7) ON:ON KEY(7) GOSUB 10500 10150 KEY(8) ON:ON KEY(8) GOSUB 10510 10160 KEY(9) ON:ON KEY(9) GOSUB 10520 10170 KEY(10) ON:ON KEY(10) GOSUB 10530 10180 REM ************************************************************** 10190 REM ** Mainline ** 10200 REM ************************************************************** 10210 SKIP$ = "INS":NOW$="INS" 10220 REC=1:GOSUB 15490 10230 IF SKIP$="INS" THEN GOSUB 10540 10240 IF SKIP$="NEW" THEN GOSUB 11000 10250 IF SKIP$="TXT" THEN GOSUB 12170 10260 IF SKIP$="SCL" THEN GOSUB 12680 10270 IF SKIP$="SSP" THEN GOSUB 13470 10280 IF SKIP$="RSP" THEN GOSUB 14330 10290 IF SKIP$="ANI" THEN GOSUB 13870 10300 IF SKIP$="RSC" THEN GOSUB 14610 10310 IF SKIP$="SSC" THEN GOSUB 14740 10320 IF SKIP$ <> "" GOTO 10230 10330 SCREEN 0,0,0:WIDTH 80:END 10340 REC=5:GOSUB 15490 10350 GOSUB 15220:IF TYPE$<>"C" THEN GOTO 10350 10360 IF X$ < "A" OR X$ > "D" THEN GOTO 10350 10370 OPEN "A:DESIGNER.DRV" FOR OUTPUT AS #1 10380 WRITE #1, X$:CLOSE #1:DRIVE$=X$:GOTO 10080 10390 REC=19:GOSUB 15490:GOSUB 15220:SCREEN 0,0,0:END ' no color/graph card 10400 REC=24:GOSUB 15490:GOSUB 15220:SCREEN 0,0,0:END ' no printer 10410 REM ************************************************************* 10420 REM ** Key Settings ** 10430 REM ************************************************************* 10440 SKIP$ = "NEW":RETURN 10450 SKIP$ = "SCL":RETURN 10460 SKIP$ = "SSP":RETURN 10470 SKIP$ = "SSC":RETURN 10480 SKIP$ = "RSP":RETURN 10490 SKIP$ = "RSC":RETURN 10500 SKIP$ = "TXT":RETURN 10510 SKIP$ = "ANI":RETURN 10520 SKIP$ = "INS":RETURN 10530 SKIP$ = "":RETURN 10540 REM ************************************************************* 10550 REM ** F9 INS = Instructions / Command List ** 10560 REM ************************************************************* 10570 NOW$="INS" 10580 REC=28:GOSUB 15490 10590 LOCATE 21,10:PRINT DRIVE$+"." 10600 GOSUB 15220:IF SKIP$<>"INS" THEN RETURN 10610 IF ASC(X$) = 8 THEN GOTO 10600 10620 IF TYPE$ <> "C" THEN GOTO 10600 10630 LOCATE 8,62:PRINT USING "\ \";" "+X$:Y$=X$ 10640 GOSUB 15220:IF SKIP$<>"INS" THEN RETURN 10650 IF TYPE$ <> "C" THEN GOTO 10640 10660 IF ASC(X$) <> 8 THEN GOTO 10690 10670 LOCATE 8,62:PRINT USING "\ \";" " 10680 GOTO 10600 10690 LOCATE 8,73:PRINT X$:Y$=Y$+X$ 10700 GOSUB 15220:IF SKIP$<>"INS" THEN RETURN 10710 IF TYPE$ <> "C" THEN GOTO 10700 10720 IF ASC(X$) <> 8 THEN GOTO 10750 10730 LOCATE 8,73:PRINT " " 10740 GOTO 10640 10750 LOCATE 8,74:PRINT X$:X$=Y$+X$ 10760 REC=0 10770 IF X$="INS" THEN GOTO 10580 10780 IF X$="GEN" THEN REC = 46 10790 IF X$="NEW" THEN REC = 140 10800 IF X$="SCL" THEN REC = 189 10810 IF X$="RSP" THEN REC = 271 10820 IF X$="SSP" THEN REC = 301 10830 IF X$="RSC" THEN REC = 328 10840 IF X$="SSC" THEN REC = 352 10850 IF X$="ANI" THEN REC = 363 10860 IF X$="TXT" THEN REC = 389 10870 IF X$="CRD" THEN REC = 435 10880 IF X$="DRV" THEN GOTO 10920 10890 IF REC <> 0 THEN GOTO 10910 10900 LOCATE 8,62:PRINT "Try Again: ":GOTO 10600 10910 GOSUB 15490:RETURN 10920 OPEN "A:DESIGNER.DRV" FOR OUTPUT AS #1 10930 IF DRIVE$="A" THEN GOTO 10980 10940 IF DRIVE$="D" THEN DRIVE$="A" 10950 IF DRIVE$="C" THEN DRIVE$="D" 10960 IF DRIVE$="B" THEN DRIVE$="C" 10970 GOTO 10990 10980 DRIVE$="B" 10990 WRITE #1,DRIVE$:CLOSE #1:RETURN 11000 REM ************************************************************* 11010 REM ** F1 NEW = New Figure or Screen ** 11020 REM ************************************************************* 11030 NOW$="NEW":REC=471:GOSUB 15490 11040 GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN 11050 IF TYPE$<>"C" THEN 11040 11060 IF X$="H" THEN GOTO 11090 11070 IF X$="M" THEN GOTO 11100 11080 GOTO 11040 11090 RES1=2:BAK=0:GOTO 11230 11100 REC = 474:RES1=1 11110 GOSUB 15490 11120 GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN 11130 IF X$="1" THEN GOTO 11160 11140 IF X$="0" THEN GOTO 11170 11150 GOTO 11120 11160 REC=478:PAL=1:GOTO 11180 11170 REC=489:PAL=0 11180 GOSUB 15490 11190 GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN 11200 IF TYPE$<>"C" THEN 11190 11210 BAK=ASC(X$)-65 11220 IF BAK<0 OR BAK >15 THEN GOTO 11190 11230 RES=RES1:CLS:CLR=1:GRID=0:SCREEN RES:LAST=0 11240 IF RES=1 THEN COLOR BAK,PAL 11250 REM ********* intermediate entry point *********** 11260 HLOC=160*RES:VLOC=100 11270 PSET(HLOC,VLOC) 11280 IF LAST=1 THEN PRESET(HLOC,VLOC+1),CLR 11290 IF LAST=2 THEN PRESET(HLOC-1,VLOC),CLR 11300 IF LAST=3 THEN PRESET(HLOC,VLOC-1),CLR 11310 IF LAST=4 THEN PRESET(HLOC+1,VLOC),CLR 11320 PURGE=1:GOSUB 15220:IF SKIP$<>"NEW" THEN RETURN 11330 IF TYPE$="G" THEN GOTO 11530 11340 IF X$ = "G" THEN GOTO 11380 11350 IF X$>="A" AND X$ <="Z" THEN HOLD$=X$ 11360 IF X$=>"0" AND X$ <="9" THEN GOTO 11580 11370 GOTO 11320 11380 IF GRID=1 THEN GOTO 11460 11390 FOR I = 9 TO 200 STEP 10 11400 LINE (0,I)-(4*RES,I),1:LINE (315*RES,I)-(320*RES,I),1 11410 NEXT I 11420 FOR I = 9 TO 320*RES STEP 10 11430 LINE (I,0)-(I,4),1:LINE (I,195)-(I,200),1 11440 NEXT I 11450 GRID=1:GOTO 11320 11460 FOR I = 9 TO 200 STEP 10 11470 LINE (0,I)-(4*RES,I),0:LINE (315*RES,I)-(320*RES,I),0 11480 NEXT I 11490 FOR I = 9 TO 320*RES STEP 10 11500 LINE (I,0)-(I,4),0:LINE (I,195)-(I,200),0 11510 NEXT I 11520 GRID=0:GOTO 11320 11530 IF X$="H" THEN GOTO 12140 11540 IF X$="M" THEN GOTO 12120 11550 IF X$="P" THEN GOTO 12100 11560 IF X$="K" THEN GOTO 12080 11570 GOTO 11320 11580 IF HOLD$ <>"P" THEN GOTO 11630 11590 IF X$<"0" OR X$>"3" OR (RES=2 AND X$>"1") THEN GOTO 11630 11600 PRESET (HLOC,VLOC) 11610 PAINT (HLOC,VLOC),(ASC(X$)-48),CLR 11620 PRESET (HLOC,VLOC),CLR 11630 IF HOLD$="F" AND X$="0" THEN CLR=0 11640 IF HOLD$="F" AND X$="1" THEN CLR=1 11650 IF HOLD$="F" AND X$="2" THEN CLR=2 11660 IF HOLD$="F" AND X$="3" THEN CLR=3 11670 IF HOLD$="F" THEN HOLD$="" 11680 IF HOLD$<>"D" OR X$ <> "1" THEN GOTO 11710 11690 VSET=VLOC:HSET=HLOC:HOLD$="" 11700 GOTO 11320 11710 IF HOLD$<>"D" OR X$ <> "2" THEN GOTO 11740 11720 LINE (HSET,VSET)-(HLOC,VLOC),CLR:HOLD$="" 11730 GOTO 11320 11740 IF HOLD$<>"C" OR X$<> "1" THEN GOTO 11770 11750 VSET=VLOC:HSET=HLOC:HOLD$="" 11760 GOTO 11320 11770 IF HOLD$<>"C" OR X$<> "2" THEN GOTO 11830 11780 IF RES=2 THEN RAD=SQR(5.7*(VSET-VLOC)^2+(HSET-HLOC)^2) 11790 IF RES=1 THEN RAD=SQR(1.45*(VSET-VLOC)^2+(HSET-HLOC)^2) 11800 CIRCLE (HSET,VSET),RAD,CLR 11810 HOLD$="" 11820 GOTO 11320 11830 IF HOLD$<>"A" OR X$<> "1" THEN GOTO 11860 11840 VSET=VLOC:HSET=HLOC:HOLD$="" 11850 GOTO 11320 11860 IF HOLD$<>"A" OR X$<>"2" THEN GOTO 11890 11870 VSET2=VLOC:HSET2=HLOC:HOLD$="" 11880 GOTO 11320 11890 IF HOLD$<>"A" OR X$<>"3" THEN GOTO 11320 11900 IF RES=2 THEN GOTO 11990 11910 RAD=SQR(1.4*(VSET-VSET2)^2+(HSET-HSET2)^2) 11920 ANG1=ATN(1.25*(VSET-VSET2)/(HSET2-HSET)) 11930 ANG2=ATN(1.25*(VSET-VLOC)/(HLOC-HSET)) 11940 IF HSET>HLOC THEN ANG2=3.14+ANG2 11950 IF HLOC>HSET AND VLOC>VSET THEN ANG2=6.28+ANG2 11960 IF HSET>HSET2 THEN ANG1=3.14+ANG1 11970 IF HSET2>HSET AND VSET2>VSET THEN ANG1=6.28+ANG1 11980 GOTO 12060 11990 RAD=SQR(5.7*(VSET-VSET2)^2+(HSET-HSET2)^2) 12000 ANG1=ATN(2.5*(VSET-VSET2)/(HSET2-HSET)) 12010 ANG2=ATN(2.5*(VSET-VLOC)/(HLOC-HSET)) 12020 IF HSET>HLOC THEN ANG2=3.14+ANG2 12030 IF HLOC>HSET AND VLOC>VSET THEN ANG2=6.28+ANG2 12040 IF HSET>HSET2 THEN ANG1=3.14+ANG1 12050 IF HSET2>HSET AND VSET2>VSET THEN ANG1=6.28+ANG1 12060 CIRCLE (HSET,VSET),RAD,CLR,ANG1,ANG2 12070 HOLD$="":GOTO 11320 12080 IF HLOC > 0 THEN HLOC=HLOC-1 12090 LAST=4:GOTO 11270 12100 IF VLOC < 199 THEN VLOC=VLOC+1 12110 LAST=3:GOTO 11270 12120 IF HLOC < RES*320-1 THEN HLOC=HLOC+1 12130 LAST=2:GOTO 11270 12140 IF VLOC > 0 THEN VLOC=VLOC-1 12150 LAST=1:GOTO 11270 12160 RETURN 12170 REM ************************************************************* 12180 REM ** F7 TXT = Add Text Characters ** 12190 REM ************************************************************* 12200 IF RES <> 0 THEN GOTO 12220 12210 NOW$="TXT":REC=500:GOSUB 15490:GOSUB 15220:RETURN 12220 NOW$="TXT":CAPS=0:START=1:MSG=0:GOSUB 15920 12230 PRESET (HLOC,VLOC),CLR 12240 OPEN "A:TEXTCHAR" AS #1 LEN=12:GOTO 12250 12250 FIELD #1,12 AS BUFFER$ 12260 DIM HOLDC(2),HOLDB(2*(3-RES)) 12270 PURGE=1:GOSUB 15220:IF SKIP$="NEW" THEN GOTO 12650 12280 IF SKIP$ <> "TXT" THEN GOTO 12640 12290 IF TYPE$="C" AND ASC(X$) > 31 AND ASC(X$) < 126 THEN GOTO 12500 12300 IF TYPE$ = "C" THEN GOTO 12270 12310 IF X$ <>"H" AND X$ <>"M" AND X$<>"P" AND X$<>"K" THEN GOTO 12270 12320 IF START=1 THEN GOTO 12270 12330 PUT (HLOC,VLOC),HOLDB,PSET 12340 IF X$="H" THEN GOTO 12390 12350 IF X$="M" THEN GOTO 12410 12360 IF X$="P" THEN GOTO 12430 12370 IF X$="K" THEN GOTO 12450 12380 GOTO 12270 12390 IF VLOC > 0 THEN VLOC=VLOC-1 12400 GOTO 12470 12410 IF HLOC < RES*320-7 THEN HLOC=HLOC+1 12420 GOTO 12470 12430 IF VLOC < 192 THEN VLOC=VLOC+1 12440 GOTO 12470 12450 IF HLOC > 0 THEN HLOC=HLOC-1 12460 GOTO 12470 12470 GET(HLOC,VLOC)-(HLOC+6,VLOC+7),HOLDB 12480 PUT (HLOC,VLOC),HOLDC,PSET 12490 GOTO 12270 12500 IF ASC(X$) > 32 THEN GOTO 12550 12510 FOR I=HLOC TO HLOC+3*RES:FOR J=VLOC TO VLOC+7 12520 PSET (I,J),0 12530 NEXT J,I 12540 GOTO 12270 12550 GET #1,ASC(X$)-32+(2-RES)*93 12560 OUTPUT$=BUFFER$ 12570 FOR J= 0 TO 2 12580 HOLDC(J)=CVS(MID$(OUTPUT$,4*J+1,4)) 12590 NEXT J 12600 HLOC=RES*160-3:VLOC=97:START=0 12610 GET(HLOC,VLOC)-(HLOC+6,VLOC+7),HOLDB 12620 PUT (HLOC,VLOC),HOLDC,PSET 12630 GOTO 12270 12640 ERASE HOLDC,HOLDB:CLOSE #1:CAPS=1:RETURN 12650 ERASE HOLDC,HOLDB:CLOSE #1:CAPS=1:SKIP$="NEW":NOW$="NEW" 12660 MSG=0:GOSUB 15920:GOTO 11260 12670 REC=503:GOSUB 15490:GOSUB 15220:RETURN 12680 REM ************************************************************* 12690 REM ** F2 SCL = Scale a Drawing Color 0,14 ** 12700 REM ************************************************************* 12710 IF RES <> 0 THEN GOTO 12730 12720 NOW$="SCL":REC=510:GOSUB 15490:GOSUB 15220:RETURN 12730 NOW$="SCL":MSG=0:GOSUB 15920 12740 SPEED=0:PRESET (HLOC,VLOC),CLR 12750 GOSUB 15220:IF SKIP$="NEW" THEN GOTO 13460 12760 IF SKIP$ <> "SCL" THEN RETURN 12770 IF TYPE$="G" THEN GOTO 12750 12780 IF X$ > "0" AND X$ <= "9" AND HOLD$ <> " " THEN SPEED = 1-(ASC(X$)-48)/25 12790 IF X$ = "E" THEN HOLD$ = "E" 12800 IF X$ = "C" THEN HOLD$ = "C" 12810 IF SPEED = 0 OR HOLD$ = " " THEN GOTO 12750 12820 IF HOLD$ = "E" THEN GOTO 13140 12830 REM ***** contract - left side ***** 12840 FOR I = 160*RES TO 0 STEP -1 12850 IF SKIP$<>"SCL" THEN RETURN 12860 PSET(I,0),1:PSET(I,199),1 12870 K=160*RES-(160*RES-I)/SPEED 12880 FOR J = 100 TO 1 STEP -1 12890 L=100-(100-J)/SPEED 12900 IF K >=0 AND L >=0 THEN PSET (I,J),POINT(K,L) ELSE PSET (I,J),0 12910 NEXT J 12920 FOR J = 101 TO 198 12930 L=100+(J-100)/SPEED 12940 IF K >=0 AND L <=199 THEN PSET (I,J),POINT(K,L) ELSE PSET (I,J),0 12950 NEXT J 12960 PSET(I,0),0:PSET(I,199),0 12970 NEXT I 12980 REM ***** contract - right side ***** 12990 FOR I = 160*RES + 1 TO 320*RES-1 13000 IF SKIP$<>"SCL" THEN RETURN 13010 PSET(I,0),1:PSET(I,199),1 13020 K=160*RES+(I-160*RES)/SPEED 13030 FOR J = 100 TO 1 STEP -1 13040 L=100-(100-J)/SPEED 13050 IF K <= 320*RES-1 AND L >= 0 THEN PSET(I,J),POINT(K,L) ELSE PSET(I,J),0 13060 NEXT J 13070 FOR J = 101 TO 198 13080 L=100+(J-100)/SPEED 13090 IF K <= 320*RES-1 AND L <=199 THEN PSET (I,J),POINT(K,L) ELSE PSET (I,J),0 13100 NEXT J 13110 PSET(I,0),0:PSET(I,199),0 13120 NEXT I 13130 SPEED = 0:HOLD$ = " ":MSG=0:GOSUB 15920:GOTO 12750 13140 REM ***** expand - left side ***** 13150 SPEED = 2-SPEED 13160 FOR I = 0 TO 160*RES 13170 IF SKIP$<>"SCL" THEN RETURN 13180 PSET(I,0),1:PSET(I,199),1 13190 K=160*RES-((160*RES-I)/SPEED) 13200 FOR J = 1 TO 100 13210 L=100-((100-J)/SPEED) 13220 PSET (I,J),POINT(K,L) 13230 NEXT J 13240 FOR J = 198 TO 101 STEP -1 13250 L=100-((100-J)/SPEED) 13260 PSET (I,J),POINT(K,L) 13270 NEXT J 13280 PSET(I,0),0:PSET(I,199),0 13290 NEXT I 13300 REM ***** expand - right side ***** 13310 FOR I = 320*RES-1 TO 160*RES + 1 STEP -1 13320 IF SKIP$<>"SCL" THEN RETURN 13330 PSET(I,0),1:PSET(I,199),1 13340 K = (I-160*RES)/SPEED + 160*RES 13350 FOR J = 1 TO 100 13360 L=100-(100-J)/SPEED 13370 PSET(I,J),POINT(K,L) 13380 NEXT J 13390 FOR J = 198 TO 101 STEP -1 13400 L=(J-100)/SPEED + 100 13410 PSET (I,J),POINT(K,L) 13420 NEXT J 13430 PSET(I,0),0:PSET(I,199),0 13440 NEXT I 13450 SPEED = 0:HOLD$ = " ":MSG=0:GOSUB 15920:GOTO 12750 13460 SKIP$="NEW":NOW$="NEW":MSG=0:GOSUB 15920:GOTO 11260 13470 REM ************************************************************* 13480 REM ** F3 SSP = Store a Sprite ** 13490 REM ************************************************************* 13500 IF RES <> 0 THEN GOTO 13520 13510 NOW$="SSP":REC=513:GOSUB 15490:GOSUB 15220:RETURN 13520 RES1=RES:NOW$="SSP" 13530 L=1:R=320*RES1:T=1:B=200:SPEED=1 13540 LINE (L,T)-(R,B),1,B 13550 PURGE=1:GOSUB 15220:IF SKIP$<>"SSP" THEN RETURN 13560 IF TYPE$="G" THEN GOTO 13780 13570 IF X$<"1" OR X$>"9" THEN GOTO 13600 13580 SPEED = ASC(X$)-48 13590 GOTO 13550 13600 IF X$<>"G" THEN GOTO 13550 13610 R=R-1:L=L+1:T=T+1:B=B-1 13620 I=4+INT(((R-L+1)*(3-RES1)+7)/8)*(B-T+1) 13630 I=INT((3+I)/4)+1:J=FRE(" ") 13640 IF J>((I*4)+500) THEN GOTO 13660 13650 MSG=1001:GOSUB 15920:GOTO 13550 13660 DIM HOLD(I) 13670 GET (L,T)-(R,B),HOLD 13680 REC=516:VLOC=6:GOSUB 15340:IF SKIP$<>"SSP" THEN GOTO 13760 13690 OPEN Y$+".SPR" FOR OUTPUT AS #1 13700 WRITE #1,RES1,PAL,I,R-L+1,B-T+1 13710 FOR J= 0 TO I 13720 K=VARPTR(HOLD(J)) 13730 WRITE #1,PEEK(K),PEEK(K+1),PEEK(K+2),PEEK(K+3) 13740 NEXT J 13750 REC = 520:GOSUB 15490:GOSUB 15220:SKIP$="INS" 13760 CLOSE #1:ERASE HOLD 13770 RETURN 13780 LINE (L,T)-(R,B),0,B 13790 IF X$="H" THEN B=B-SPEED 13800 IF X$="M" THEN L=L+SPEED 13810 IF X$="P" THEN T=T+SPEED 13820 IF X$="K" THEN R=R-SPEED 13830 IF B<T+2 THEN B=T+2 13840 IF L>R-2 THEN L=R-2 13850 GOTO 13540 13860 RETURN 13870 REM ************************************************************* 13880 REM ** F8 ANI = Test Animation ** 13890 REM ************************************************************* 13900 NOW$="ANI":REC=521:VLOC=4:GOSUB 15340:IF SKIP$<>"ANI" THEN RETURN 13910 REC=524:Z$=Y$:VLOC=6:GOSUB 15340:IF SKIP$<>"ANI" THEN RETURN 13920 OPEN Z$+".RES" FOR INPUT AS #1:GOTO 13930 13930 INPUT #1,RES1,BAK,PAL1 13940 CLOSE #1 13950 OPEN Y$+".SPR" FOR INPUT AS #1:GOTO 13960 13960 INPUT #1,RES,PAL,I,WID,HGHT 13970 DIM HOLDC(I),HOLDB(I):GOTO 13980 13980 FOR J=0 TO I 13990 K=VARPTR(HOLDC(J)):INPUT #1,H(0),H(1),H(2),H(3) 14000 FOR L=0 TO 3:POKE K+L,H(L):NEXT L 14010 NEXT J 14020 CLOSE #1 14030 HLOC=(320*RES-WID)/2:VLOC=(200-HGHT)/2 14040 SCREEN RES 14050 IF RES = 1 THEN COLOR BAK,PAL 14060 DEF SEG=&HB800 14070 BLOAD Z$,0 14080 DEF SEG 14090 GET (HLOC,VLOC)-(HLOC+WID-1,VLOC+HGHT-1),HOLDB 14100 Y$="P":PUT (HLOC,VLOC),HOLDC,PSET 14110 PURGE=1:GOSUB 15220: IF SKIP$ <> "ANI" THEN GOTO 14290 14120 IF TYPE$ <> "G" THEN GOTO 14240 14130 PUT (HLOC,VLOC),HOLDB,PSET 14140 IF X$ = "H" AND VLOC > 0 THEN VLOC=VLOC-1 14150 IF X$ = "M" AND HLOC < RES*319-WID+1 THEN HLOC=HLOC+1 14160 IF X$ = "P" AND VLOC < 200-HGHT THEN VLOC=VLOC+1 14170 IF X$ = "K" AND HLOC > 0 THEN HLOC=HLOC-1 14180 GET (HLOC,VLOC)-(HLOC+WID-1,VLOC+HGHT-1),HOLDB 14190 IF Y$="P" THEN PUT (HLOC,VLOC),HOLDC,PSET 14200 IF Y$="A" THEN PUT (HLOC,VLOC),HOLDC,AND 14210 IF Y$="O" THEN PUT (HLOC,VLOC),HOLDC,OR 14220 IF Y$="X" THEN PUT (HLOC,VLOC),HOLDC,XOR 14230 GOTO 14110 14240 IF X$="X" THEN Y$="X" 14250 IF X$="A" THEN Y$="A" 14260 IF X$="O" THEN Y$="O" 14270 IF X$="P" THEN Y$="P" 14280 GOTO 14110 14290 CLOSE #1:ERASE HOLDB:ERASE HOLDC:RETURN 14300 REC=525:GOSUB 15490:GOSUB 15220:RETURN 14310 REC=528:GOSUB 15490:GOSUB 15220:RETURN 14320 REC=531:GOSUB 15490:GOSUB 15220:RETURN 14330 REM ************************************************************* 14340 REM ** F5 RSP = Retrieve a Sprite ** 14350 REM ************************************************************* 14360 NOW$="RSP":REC=534:VLOC=4:GOSUB 15340:IF SKIP$<>"RSP" THEN RETURN 14370 OPEN Y$+".SPR" FOR INPUT AS #1 14380 INPUT #1,RES1,PAL,I,WID,HGHT 14390 DIM HOLDC(I) 14400 IF RES1 <>1 THEN GOTO 14460 14410 REC=537:GOSUB 15490 14420 GOSUB 15220:IF SKIP$<>"RSP" THEN GOTO 14580 14430 IF TYPE$<>"C" THEN 14420 14440 BAK=ASC(X$)-65 14450 IF BAK<0 OR BAK >15 THEN GOTO 14420 14460 SCREEN RES1:RES=RES1 14470 CLS 14480 IF RES=1 THEN COLOR BAK,PAL 14490 FOR J= 0 TO I 14500 K=VARPTR(HOLDC(J)):INPUT #1,H(0),H(1),H(2),H(3) 14510 FOR L=0 TO 3:POKE K+L,H(L):NEXT L 14520 NEXT J 14530 HLOC=(320*RES-WID)/2:VLOC=(200-HGHT)/2 14540 PUT (HLOC,VLOC),HOLDC:ERASE HOLDC 14550 CLOSE #1 14560 SKIP$="NEW":NOW$="NEW" 14570 GOTO 11260 14580 CLOSE #1:ERASE HOLD:RETURN 14590 REC=572:GOSUB 15490:GOSUB 15220:RETURN 14600 REC=548:GOSUB 15490:GOSUB 15220:RETURN 14610 REM ************************************************************* 14620 REM ** F6 RSC = Retrieve a Screen ** 14630 REM ************************************************************* 14640 NOW$="RSC":REC=551:VLOC=4:GOSUB 15340:IF SKIP$<>"RSC" THEN RETURN 14650 OPEN Y$+".RES" FOR INPUT AS #1:INPUT #1,RES,BAK,PAL:CLOSE #1 14660 SCREEN RES 14670 IF RES=1 THEN COLOR BAK,PAL 14680 DEF SEG=&HB800 14690 BLOAD Y$,0 14700 DEF SEG 14710 SKIP$="NEW":NOW$="NEW" 14720 GOTO 11260 14730 REC=554:GOSUB 15490:GOSUB 15220:RETURN 14740 REM ************************************************************* 14750 REM ** F4 SSC = Store a Screen Color 0,3 ** 14760 REM ************************************************************* 14770 IF RES <> 0 THEN GOTO 14790 14780 NOW$="SSC":REC=557:GOSUB 15490:GOSUB 15220:RETURN 14790 RES1=RES:NOW$="SSC":PRESET (HLOC,VLOC),CLR 14800 DEF SEG= &HB800 14810 BSAVE DRIVE$+":SCREEN",0,&H4000:DEF SEG 14820 REC=560:VLOC=19:GOSUB 15340:IF SKIP$<>"SSC" THEN RETURN 14830 IF LEN(Y$) > 2 THEN NAME DRIVE$+":SCREEN.BAS" AS Y$+".BAS":GOTO 14840 14840 IF LEN(Y$) = 2 THEN Y$ = DRIVE$+":SCREEN" 14850 OPEN Y$+".RES" FOR OUTPUT AS #1 14860 WRITE #1,RES1,BAK,PAL 14870 CLOSE #1:CLS:REC=569 14880 NOW$="INS":SKIP$="INS":GOSUB 15490 14890 RETURN 14900 REC=571:GOSUB 15490:LOCATE 19,37:PRINT " ":GOTO 14820 14910 REC=576:GOSUB 15490:LOCATE 19,37:PRINT " ":RETURN 14920 REC=581:GOSUB 15490:LOCATE 19,37:PRINT " ":RETURN 14930 REM ************************************************************* 14940 REM ** Error Handling ** 14950 REM ************************************************************* 14960 MSG=ERR:GOSUB 15920 14970 IF ERR = 7 AND ERL = 13970 THEN RESUME 14320 14980 IF ERR = 7 AND ERL = 14390 THEN RESUME 14600 14990 IF (ERR = 24 OR ERR = 25) AND ERL = 15790 THEN RESUME 15850 15000 IF ERR = 61 AND ERL = 14810 THEN RESUME 14910 15010 IF ERR = 61 AND ERL = 14870 THEN RESUME 14920 15020 IF ERR = 68 AND ERL = 15790 THEN RESUME 10400 15030 IF (ERR = 53 OR ERR = 52) AND ERL = 10050 THEN RESUME 10340 15040 IF (ERR = 53 OR ERR = 52) AND ERL = 12240 THEN RESUME 12670 15050 IF (ERR = 53 OR ERR = 52) AND ERL = 13920 THEN RESUME 14300 15060 IF (ERR = 53 OR ERR = 52) AND ERL = 13950 THEN RESUME 14310 15070 IF (ERR = 53 OR ERR = 52) AND ERL = 14370 THEN RESUME 14590 15080 IF (ERR = 53 OR ERR = 52) AND ERL = 14650 THEN RESUME 14730 15090 IF ERR = 58 AND ERL = 14830 THEN RESUME 14900 15100 IF ERR = 71 AND ERL = 15530 THEN RESUME 15860 15110 IF ERR = 72 AND ERL = 15530 THEN RESUME 15910 15120 CLS 15130 PRINT "Error number ",ERR," at line number ",ERL 15140 PRINT 15150 PRINT "Please notify: Jan Young" 15160 PRINT " 767 N. Holden St." 15170 PRINT " Port Washington, Wi. 53074" 15180 PRINT 15190 PRINT "Please include the error number and line number above and" 15200 PRINT "as much information about what you were doing as possible." 15210 END 15220 REM ************************************************************* 15230 REM ** Read From Keyboard ** 15240 REM ************************************************************* 15250 IF PURGE=0 THEN 15270 15260 DEF SEG=&H40:POKE &H1A,PEEK(&H1C):DEF SEG 15270 X$=INKEY$:IF SKIP$<>NOW$ THEN PURGE=0:RETURN 15280 IF X$="" THEN 15270 15290 IF LEN(X$)<>2 THEN 15320 15300 X$=MID$(X$,2,1) 15310 TYPE$="G":PURGE=0:RETURN 15320 IF ASC(X$)>96 AND CAPS=1 THEN X$=CHR$(ASC(X$)-32) 15330 TYPE$="C":PURGE=0:RETURN 15340 REM ************************************************************* 15350 REM ** Read 8 Characters From Keyboard ** 15360 REM ************************************************************* 15370 Y$=DRIVE$+":":GOSUB 15490 15380 FOR J=1 TO 8 15390 GOSUB 15220:IF SKIP$<>NOW$ THEN RETURN 15400 IF TYPE$<>"C" THEN 15390 15410 IF ASC(X$) <> 8 THEN GOTO 15440 15420 IF J=1 THEN GOTO 15390 15430 J=J-1:X$=" ":LOCATE VLOC,62+J:PRINT X$:Y$=MID$(Y$,1,J+1):GOTO 15390 15440 IF ASC(X$) = 13 THEN GOTO 15480 15450 IF ASC(X$) = 46 THEN GOTO 15390 15460 LOCATE VLOC,62+J:PRINT X$:Y$=Y$+X$ 15470 NEXT J 15480 RETURN 15490 REM ************************************************************* 15500 REM ** Print Verbiage Screens ** 15510 REM ************************************************************* 15520 WIDTH 80:SCREEN 0,1:RES=0 15530 OPEN "A:VERBIAGE" AS #2 LEN=85 15540 FIELD #2,85 AS BUFFER$ 15550 GET 2,REC:OUTREC$ = BUFFER$ 15560 IF SKIP$<>NOW$ THEN GOTO 15770 15570 IF MID$(OUTREC$,1,3)<>"c01" THEN GOTO 15600 15580 COLOR (VAL(MID$(OUTREC$,4,2))),(VAL(MID$(OUTREC$,6,2))),(VAL(MID$(OUTREC$,8,2))) 15590 CLS:REC=REC+1:GOTO 15550 15600 IF MID$(OUTREC$,1,3)="p01" THEN GOTO 15780 15610 LOCATE (VAL(MID$(OUTREC$,4,2))),(VAL(MID$(OUTREC$,6,2))),0 15620 IF VAL(MID$(OUTREC$,6,2))>8 THEN PRINT MID$(OUTREC$,8,78-(VAL(MID$(OUTREC$,6,2)))) 15630 IF VAL(MID$(OUTREC$,6,2))<9 THEN PRINT MID$(OUTREC$,8,70) 15640 IF MID$(OUTREC$,82,1) <> " " AND MID$(OUTREC$,82,1) <> "I" THEN GOTO 15680 15650 REC = REC +1 15660 IF VAL(MID$(OUTREC$,78,4)) <> 0 THEN REC=VAL(MID$(OUTREC$,78,4)) 15670 GOTO 15550 15680 IF MID$(OUTREC$,82,1) <> "P" THEN GOTO 15740 15690 LOCATE 23,28,0:PRINT "Press Any Key to Continue" 15700 GOSUB 15220:IF SKIP$ <> NOW$ THEN GOTO 15770 15710 CLS:REC=REC+1 15720 IF VAL(MID$(OUTREC$,78,4)) <> 0 THEN REC=VAL(MID$(OUTREC$,78,4)) 15730 GOTO 15550 15740 IF MID$(OUTREC$,82,1) <> "E" THEN GOTO 15770 15750 LOCATE 23,28,0:PRINT "Press Any Key to Continue" 15760 GOSUB 15220 15770 CLOSE #2:RETURN 15780 IF MID$(OUTREC$,4,1) = "1" THEN LPRINT 15790 LPRINT USING "& &";MID$(OUTREC$,8,35);MID$(OUTREC$,43,35) 15800 IF MID$(OUTREC$,82,1) <> " " AND MID$(OUTREC$,82,1) <> "I" THEN GOTO 15840 15810 REC = REC +1 15820 IF VAL(MID$(OUTREC$,78,4)) <> 0 THEN REC=VAL(MID$(OUTREC$,78,4)) 15830 GOTO 15550 15840 CLOSE #2:RETURN 15850 REC=615:GOSUB 15490:GOSUB 15220:GOTO 15790 ' printer not ready 15860 CLS:PRINT "Your disk drive is not ready. Please insert The Designer's" 15870 PRINT "disk in Drive A and close the door." 15880 PRINT 15890 PRINT "Press any key to Continue" 15900 GOSUB 15220:GOTO 15530 15910 REC=623:GOSUB 15490:GOSUB 15220:GOTO 15530 ' disk i/o error 15920 REM ************************************************************* 15930 REM ** Sound Effects ** 15940 REM ************************************************************* 15950 IF MSG = 0 THEN PLAY "t255mso3c8c8c8" 15960 IF MSG > 0 THEN PLAY "t255o1c8e-8c8e-8" 15970 RETURN